Exercise I: Principal Component Analysis

Recall the mtcars dataset we work with before, which compirses fuel consumption and other aspects of design and performance for 32 cars from 1974. The dataset has 11 dimensions, that is more than it is possible to visualize at the same.

head(mtcars)
                   mpg cyl disp  hp drat    wt  qsec vs am gear carb
Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1
  1. Use prcomp() to compute a PCA for mtcars. Remember to set the scale parameter, as the variables are in different units and have different ranges
mtcars.pca <- prcomp(mtcars, scale=TRUE)
  1. Generate a scree plot and note how many dimensions should you retain.
plot(mtcars.pca)

  1. Compute the percentage of variance explained by each of the principal components.
eig <- mtcars.pca$sdev^2
(var.exp <- 100*eig/sum(eig))
 [1] 60.0763659 24.0951627  5.7017934  2.4508858  2.0313737  1.9236011
 [7]  1.2296544  1.1172858  0.7004241  0.4730495  0.2004037
  1. Generate a biplot for the PCA projection. Use the loadings matrix to inspect which variables contributes most to PC1 and which to PC2. What do the PC1 and PC2 correspond to? How are the cars distributed on this representation? Does the “car map” make sense?
biplot(mtcars.pca, cex = 1.5)

mtcars.pca$rotation
            PC1         PC2         PC3          PC4         PC5         PC6
mpg  -0.3625305  0.01612440 -0.22574419 -0.022540255  0.10284468 -0.10879743
cyl   0.3739160  0.04374371 -0.17531118 -0.002591838  0.05848381  0.16855369
disp  0.3681852 -0.04932413 -0.06148414  0.256607885  0.39399530 -0.33616451
hp    0.3300569  0.24878402  0.14001476 -0.067676157  0.54004744  0.07143563
drat -0.2941514  0.27469408  0.16118879  0.854828743  0.07732727  0.24449705
wt    0.3461033 -0.14303825  0.34181851  0.245899314 -0.07502912 -0.46493964
qsec -0.2004563 -0.46337482  0.40316904  0.068076532 -0.16466591 -0.33048032
vs   -0.3065113 -0.23164699  0.42881517 -0.214848616  0.59953955  0.19401702
am   -0.2349429  0.42941765 -0.20576657 -0.030462908  0.08978128 -0.57081745
gear -0.2069162  0.46234863  0.28977993 -0.264690521  0.04832960 -0.24356284
carb  0.2140177  0.41357106  0.52854459 -0.126789179 -0.36131875  0.18352168
              PC7          PC8          PC9        PC10         PC11
mpg   0.367723810 -0.754091423  0.235701617  0.13928524 -0.124895628
cyl   0.057277736 -0.230824925  0.054035270 -0.84641949 -0.140695441
disp  0.214303077  0.001142134  0.198427848  0.04937979  0.660606481
hp   -0.001495989 -0.222358441 -0.575830072  0.24782351 -0.256492062
drat  0.021119857  0.032193501 -0.046901228 -0.10149369 -0.039530246
wt   -0.020668302 -0.008571929  0.359498251  0.09439426 -0.567448697
qsec  0.050010522 -0.231840021 -0.528377185 -0.27067295  0.181361780
vs   -0.265780836  0.025935128  0.358582624 -0.15903909  0.008414634
am   -0.587305101 -0.059746952 -0.047403982 -0.17778541  0.029823537
gear  0.605097617  0.336150240 -0.001735039 -0.21382515 -0.053507085
carb -0.174603192 -0.395629107  0.170640677  0.07225950  0.319594676
  1. You can install the package ggfortify and use autoplot on prcomp objects to generate easily ggplots.
# install.packages("ggfortify")
library(ggfortify)
library(dplyr)
mtcars <- mtcars %>%
  mutate(am = factor(am), gear = factor(gear), cyl = factor(cyl))
autoplot(mtcars.pca, data = mtcars, label = TRUE, label.size = 4, colour = 'cyl')

autoplot(mtcars.pca, data = mtcars, label = TRUE, label.size = 4, colour = 'gear') 

autoplot(mtcars.pca, data = mtcars, label = FALSE, colour = 'am',
         loadings.label = TRUE, loadings.label.size  = 4)

autoplot(mtcars.pca, size = 0, label = TRUE, label.size = 4,
         loadings = TRUE, loadings.label = TRUE, 
         loadings.label.size  = 5) + theme_classic()

Exercise 2: Cluster Analysis

Part 1: k-means clustering

We will generate synthetic clustered data to use for k-means clustering.

set.seed(489576)
N <- 1000
C1 <- data.frame(cluster = "C1", x = rnorm(n = N, mean = 1), y = rnorm(n = N, mean = 1))
C2 <- data.frame(cluster = "C2", x = rnorm(n = N, mean = -2), y = rnorm(n = N, mean = -5))
C3 <- data.frame(cluster = "C3", x = rnorm(n = N, mean = 5), y = rnorm(n = N, mean = 1))
DF <- rbind(C1, C2, C3)
ggplot(DF, aes(x, y, color = cluster)) + 
  geom_point()

  1. Apply k-means with k = 3 (as you know the true number of clusters). Pring the cluster centers.
kmeans.res <- kmeans(x = DF[, -1], centers = 3)
kmeans.res$centers
           x          y
1  0.9614141  1.0058486
2 -2.0431190 -4.9932291
3  5.0098346  0.9780214
  1. Print a confusion map to compare k-means cluster assignment with the true cluster labels.
table(kmeans = kmeans.res$cluster, true = DF$cluster)
      true
kmeans  C1  C2  C3
     1 968   1  23
     2   0 999   0
     3  32   0 977
  1. Generate a scatter plot of points, now colored by the cluster assignment.
library(ggplot2)
DF$kmeans <- factor(kmeans.res$cluster)
ggplot(DF, aes(x, y)) + 
  geom_point(alpha = 0.5, aes( color = kmeans)) + 
  geom_point(data = data.frame(x = kmeans.res$centers[, 1], 
                               y = kmeans.res$centers[, 2]), size = 3, aes(x, y), color = "Black")

  1. Now pretend that you don’t know the real number of clusters. Use k = 4 and recompute kmeans. Plot the results and see what happened.
kmeans.res2 <- kmeans(x = DF[, -1], centers = 4)
kmeans.res2$centers
           x          y kmeans
1  5.3301476  1.7351006      3
2  4.7001362  0.2460306      3
3  0.9614141  1.0058486      1
4 -2.0431190 -4.9932291      2
DF$kmeans2 <- factor(kmeans.res2$cluster)
ggplot(DF, aes(x, y, color = kmeans2)) + 
  geom_point(alpha = 0.5)

Part 2: Hierarchical Clustering

In this exercise you will you use a dataset published in a study by Khan et al. 2001 to perform a hierarchical clustering of the patients in the study based on their overall gene expression data.

This data set consists of expression levels for 2,308 genes. The training and test sets consist of 63 and 20 observations (tissue samples) respectively.

Here, we will use the train set, as we now are only interested in learning how hclust() works. First, load the ISLR where the data is available. The gene expression data is available in an object Khan$xtrain; you can learn more about the data set by typing in ?Khan after loading ISLR package.

library(ISLR)
gene.expression <- Khan$xtrain
dim(gene.expression)
[1]   63 2308
  1. Compute a (Euclidean) distance matrix between each pair of samples.
D <- dist(gene.expression)
  1. Perform hierarchical clustering using average linkage.
khan.hclust <- hclust(D, method = "average")
  1. Plot a dendrogram associated with the hierarchical clustering you just computed. In this example, you actually have the lables of the tissue samples, however, the algorithms was blinded to them. By adding labels to the dendrogram corresponding to Khan$ytrain, check if the clustering performed groups the observations from same tumor class nearby.
plot(khan.hclust, labels = Khan$ytrain)

Exercise Extra: 2D visualization of MNIST data

  • Download MNIST data of the digits images from Kaggle competition.
  • The code is adapted from the one found here.

The files are data on the 28x28 pixel images of digits (0-9). The data is composed of:

  • label column denoting the digit on the image
  • pixel0 through pixel783 contain information on the pixel intensity (on the scale of 0-255), and together form the vectorized version of the 28x28 pixel digit image

Download the data from the course repository:

# load the already subsetted MNIST data.
mnist.url <- "https://github.com/cme195/cme195.github.io/raw/master/assets/data/mnist_small.csv"
train <- read.csv(mnist.url, row.names = 1)
dim(train)
[1] 1000  785
train[1:10, 1:10]
      label pixel0 pixel1 pixel2 pixel3 pixel4 pixel5 pixel6 pixel7 pixel8
4776      5      0      0      0      0      0      0      0      0      0
26136     0      0      0      0      0      0      0      0      0      0
25589     7      0      0      0      0      0      0      0      0      0
26181     0      0      0      0      0      0      0      0      0      0
36156     9      0      0      0      0      0      0      0      0      0
26890     3      0      0      0      0      0      0      0      0      0
399       4      0      0      0      0      0      0      0      0      0
9766      1      0      0      0      0      0      0      0      0      0
27971     2      0      0      0      0      0      0      0      0      0
21594     6      0      0      0      0      0      0      0      0      0
  1. Compute and the PCA for the data. Then, extract the first two principal component scores for the data.
# compare with pca
pca <- prcomp(train[,-1])
coord.pca <- data.frame(pca$x[, 1:2])
coord.pca$label <- factor(train$label)
  1. Plot the 2D principal component scores matrix.
ggplot(coord.pca, aes(x= PC1, y = PC2)) + ggtitle("PCA") +
  geom_text(aes(label = label, color = label), alpha = 0.8)

  1. Compute a tSNE embedding.
# Use tsne
library(Rtsne)
set.seed(123) # for reproducibility
tsne <- Rtsne(train[,-1], dims = 2, perplexity=30, 
              verbose=FALSE, max_iter = 500)
coord.tsne <- data.frame(tsne$Y)
coord.tsne$label <- factor(train$label)
  1. Visualize the tSNE 2D projection.
ggplot(coord.tsne, aes(x= X1, y = X2)) + ggtitle("tSNE") +
  geom_text(aes(label = label, color = label), alpha = 0.8)

  1. What do you observe? How does tSNE compare with PCA in this case?

tSNE seems to be much better at separating digits from each other

sessionInfo()
R version 3.5.0 (2018-04-23)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS Sierra 10.12.6

Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] Rtsne_0.13          ggfortify_0.4.4     randomForest_4.6-14
 [4] ISLR_1.2            forcats_0.3.0       stringr_1.3.1      
 [7] dplyr_0.7.99.9000   purrr_0.2.5         readr_1.1.1        
[10] tidyr_0.8.1         tibble_1.4.2        ggplot2_3.0.0.9000 
[13] tidyverse_1.2.1    

loaded via a namespace (and not attached):
 [1] tidyselect_0.2.4 haven_1.1.2      lattice_0.20-35  colorspace_1.3-2
 [5] htmltools_0.3.6  yaml_2.2.0       base64enc_0.1-3  utf8_1.1.4      
 [9] rlang_0.2.2.9002 pillar_1.3.0     glue_1.3.0       withr_2.1.2     
[13] modelr_0.1.2     readxl_1.1.0     plyr_1.8.4       munsell_0.5.0   
[17] gtable_0.2.0     cellranger_1.1.0 rvest_0.3.2      evaluate_0.11   
[21] labeling_0.3     knitr_1.20       fansi_0.2.3      broom_0.5.0     
[25] Rcpp_0.12.19.2   scales_1.0.0     backports_1.1.2  jsonlite_1.5    
[29] gridExtra_2.3    hms_0.4.2        digest_0.6.17    stringi_1.2.4   
[33] grid_3.5.0       rprojroot_1.3-2  cli_1.0.0        tools_3.5.0     
[37] magrittr_1.5     lazyeval_0.2.1   crayon_1.3.4     pkgconfig_2.0.2 
[41] xml2_1.2.0       lubridate_1.7.4  assertthat_0.2.0 rmarkdown_1.10  
[45] httr_1.3.1       rstudioapi_0.7   R6_2.2.2         nlme_3.1-137    
[49] compiler_3.5.0
LS0tCnRpdGxlOiAiTGVjdHVyZSA4OiBFeGVyY2lzZXMgd2l0aCBBbnN3ZXJzIgpkYXRlOiBPY3RvYmVyIDIzdGgsIDIwMTgKb3V0cHV0OiAKICBodG1sX25vdGVib29rOgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKLS0tCgoKIyBFeGVyY2lzZSBJOiBQcmluY2lwYWwgQ29tcG9uZW50IEFuYWx5c2lzCgpSZWNhbGwgdGhlIGBtdGNhcnNgIGRhdGFzZXQgd2Ugd29yayB3aXRoIGJlZm9yZSwgd2hpY2ggY29tcGlyc2VzIGZ1ZWwgCmNvbnN1bXB0aW9uIGFuZCBvdGhlciBhc3BlY3RzIG9mIGRlc2lnbiBhbmQgcGVyZm9ybWFuY2UgZm9yIDMyIGNhcnMgZnJvbSAxOTc0LgpUaGUgZGF0YXNldCBoYXMgMTEgZGltZW5zaW9ucywgdGhhdCBpcyBtb3JlIHRoYW4gaXQgaXMgcG9zc2libGUgdG8gdmlzdWFsaXplIGF0IAp0aGUgc2FtZS4KCmBgYHtyfQpoZWFkKG10Y2FycykKYGBgCgphLiBVc2UgYHByY29tcCgpYCB0byBjb21wdXRlIGEgUENBIGZvciBgbXRjYXJzYC4gUmVtZW1iZXIgdG8gc2V0IHRoZQpzY2FsZSBwYXJhbWV0ZXIsIGFzIHRoZSB2YXJpYWJsZXMgYXJlIGluIGRpZmZlcmVudCB1bml0cyBhbmQgaGF2ZSBkaWZmZXJlbnQKcmFuZ2VzCgpgYGB7cn0KbXRjYXJzLnBjYSA8LSBwcmNvbXAobXRjYXJzLCBzY2FsZT1UUlVFKQpgYGAKCmIuIEdlbmVyYXRlIGEgc2NyZWUgcGxvdCBhbmQgbm90ZSBob3cgbWFueSBkaW1lbnNpb25zIHNob3VsZCB5b3UgcmV0YWluLgoKYGBge3J9CnBsb3QobXRjYXJzLnBjYSkKYGBgCgpjLiBDb21wdXRlIHRoZSBwZXJjZW50YWdlIG9mIHZhcmlhbmNlIGV4cGxhaW5lZCBieSBlYWNoIG9mIHRoZSBwcmluY2lwYWwKY29tcG9uZW50cy4KCmBgYHtyfQplaWcgPC0gbXRjYXJzLnBjYSRzZGV2XjIKKHZhci5leHAgPC0gMTAwKmVpZy9zdW0oZWlnKSkKYGBgCgpkLiBHZW5lcmF0ZSBhIGJpcGxvdCBmb3IgdGhlIFBDQSBwcm9qZWN0aW9uLiBVc2UgdGhlIGxvYWRpbmdzIG1hdHJpeCB0byBpbnNwZWN0CndoaWNoIHZhcmlhYmxlcyBjb250cmlidXRlcyBtb3N0IHRvIFBDMSBhbmQgd2hpY2ggdG8gUEMyLiBXaGF0IGRvIHRoZSBQQzEgYW5kClBDMiBjb3JyZXNwb25kIHRvPyBIb3cgYXJlIHRoZSBjYXJzIGRpc3RyaWJ1dGVkIG9uIHRoaXMgcmVwcmVzZW50YXRpb24/CkRvZXMgdGhlICJjYXIgbWFwIiBtYWtlIHNlbnNlPwoKYGBge3IsIGZpZy53aWR0aD04LCBmaWcuaGVpZ2h0PTZ9CmJpcGxvdChtdGNhcnMucGNhLCBjZXggPSAxLjUpCmBgYAoKYGBge3J9Cm10Y2Fycy5wY2Ekcm90YXRpb24KYGBgCgoKZS4gWW91IGNhbiBpbnN0YWxsIHRoZSBwYWNrYWdlIGBnZ2ZvcnRpZnlgIGFuZCB1c2UgYGF1dG9wbG90YCBvbiBgcHJjb21wYApvYmplY3RzIHRvIGdlbmVyYXRlIGVhc2lseSBnZ3Bsb3RzLgoKCmBgYHtyfQojIGluc3RhbGwucGFja2FnZXMoImdnZm9ydGlmeSIpCmxpYnJhcnkoZ2dmb3J0aWZ5KQpsaWJyYXJ5KGRwbHlyKQptdGNhcnMgPC0gbXRjYXJzICU+JQogIG11dGF0ZShhbSA9IGZhY3RvcihhbSksIGdlYXIgPSBmYWN0b3IoZ2VhciksIGN5bCA9IGZhY3RvcihjeWwpKQphdXRvcGxvdChtdGNhcnMucGNhLCBkYXRhID0gbXRjYXJzLCBsYWJlbCA9IFRSVUUsIGxhYmVsLnNpemUgPSA0LCBjb2xvdXIgPSAnY3lsJykKYGBgCgpgYGB7cn0KYXV0b3Bsb3QobXRjYXJzLnBjYSwgZGF0YSA9IG10Y2FycywgbGFiZWwgPSBUUlVFLCBsYWJlbC5zaXplID0gNCwgY29sb3VyID0gJ2dlYXInKSAKYGBgCgpgYGB7cn0KYXV0b3Bsb3QobXRjYXJzLnBjYSwgZGF0YSA9IG10Y2FycywgbGFiZWwgPSBGQUxTRSwgY29sb3VyID0gJ2FtJywKICAgICAgICAgbG9hZGluZ3MubGFiZWwgPSBUUlVFLCBsb2FkaW5ncy5sYWJlbC5zaXplICA9IDQpCmBgYAoKCmBgYHtyfQphdXRvcGxvdChtdGNhcnMucGNhLCBzaXplID0gMCwgbGFiZWwgPSBUUlVFLCBsYWJlbC5zaXplID0gNCwKICAgICAgICAgbG9hZGluZ3MgPSBUUlVFLCBsb2FkaW5ncy5sYWJlbCA9IFRSVUUsIAogICAgICAgICBsb2FkaW5ncy5sYWJlbC5zaXplICA9IDUpICsgdGhlbWVfY2xhc3NpYygpCmBgYAoKCiMgRXhlcmNpc2UgMjogQ2x1c3RlciBBbmFseXNpcwoKIyMgUGFydCAxOiBrLW1lYW5zIGNsdXN0ZXJpbmcKCldlIHdpbGwgZ2VuZXJhdGUgc3ludGhldGljIGNsdXN0ZXJlZCBkYXRhIHRvIHVzZSBmb3Igay1tZWFucyBjbHVzdGVyaW5nLgpgYGB7cn0Kc2V0LnNlZWQoNDg5NTc2KQpOIDwtIDEwMDAKQzEgPC0gZGF0YS5mcmFtZShjbHVzdGVyID0gIkMxIiwgeCA9IHJub3JtKG4gPSBOLCBtZWFuID0gMSksIHkgPSBybm9ybShuID0gTiwgbWVhbiA9IDEpKQpDMiA8LSBkYXRhLmZyYW1lKGNsdXN0ZXIgPSAiQzIiLCB4ID0gcm5vcm0obiA9IE4sIG1lYW4gPSAtMiksIHkgPSBybm9ybShuID0gTiwgbWVhbiA9IC01KSkKQzMgPC0gZGF0YS5mcmFtZShjbHVzdGVyID0gIkMzIiwgeCA9IHJub3JtKG4gPSBOLCBtZWFuID0gNSksIHkgPSBybm9ybShuID0gTiwgbWVhbiA9IDEpKQpERiA8LSByYmluZChDMSwgQzIsIEMzKQpgYGAKCmBgYHtyfQpnZ3Bsb3QoREYsIGFlcyh4LCB5LCBjb2xvciA9IGNsdXN0ZXIpKSArIAogIGdlb21fcG9pbnQoKQpgYGAKCmEuIEFwcGx5IGstbWVhbnMgd2l0aCBrID0gMyAoYXMgeW91IGtub3cgdGhlIHRydWUgbnVtYmVyIG9mIGNsdXN0ZXJzKS4KUHJpbmcgdGhlIGNsdXN0ZXIgY2VudGVycy4KCmBgYHtyfQprbWVhbnMucmVzIDwtIGttZWFucyh4ID0gREZbLCAtMV0sIGNlbnRlcnMgPSAzKQprbWVhbnMucmVzJGNlbnRlcnMKYGBgCgpiLiBQcmludCBhIGNvbmZ1c2lvbiBtYXAgdG8gY29tcGFyZSBrLW1lYW5zIGNsdXN0ZXIgYXNzaWdubWVudCB3aXRoCnRoZSB0cnVlIGNsdXN0ZXIgbGFiZWxzLgoKYGBge3J9CnRhYmxlKGttZWFucyA9IGttZWFucy5yZXMkY2x1c3RlciwgdHJ1ZSA9IERGJGNsdXN0ZXIpCmBgYAoKCmMuIEdlbmVyYXRlIGEgc2NhdHRlciBwbG90IG9mIHBvaW50cywgbm93IGNvbG9yZWQgYnkgdGhlIGNsdXN0ZXIgYXNzaWdubWVudC4KCgpgYGB7cn0KbGlicmFyeShnZ3Bsb3QyKQpERiRrbWVhbnMgPC0gZmFjdG9yKGttZWFucy5yZXMkY2x1c3RlcikKZ2dwbG90KERGLCBhZXMoeCwgeSkpICsgCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuNSwgYWVzKCBjb2xvciA9IGttZWFucykpICsgCiAgZ2VvbV9wb2ludChkYXRhID0gZGF0YS5mcmFtZSh4ID0ga21lYW5zLnJlcyRjZW50ZXJzWywgMV0sIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgeSA9IGttZWFucy5yZXMkY2VudGVyc1ssIDJdKSwgc2l6ZSA9IDMsIGFlcyh4LCB5KSwgY29sb3IgPSAiQmxhY2siKQpgYGAKCmQuIE5vdyBwcmV0ZW5kIHRoYXQgeW91IGRvbid0IGtub3cgdGhlIHJlYWwgbnVtYmVyIG9mIGNsdXN0ZXJzLiBVc2UgayA9IDQKYW5kIHJlY29tcHV0ZSBrbWVhbnMuIFBsb3QgdGhlIHJlc3VsdHMgYW5kIHNlZSB3aGF0IGhhcHBlbmVkLgoKYGBge3J9CmttZWFucy5yZXMyIDwtIGttZWFucyh4ID0gREZbLCAtMV0sIGNlbnRlcnMgPSA0KQprbWVhbnMucmVzMiRjZW50ZXJzCmBgYAoKYGBge3J9CkRGJGttZWFuczIgPC0gZmFjdG9yKGttZWFucy5yZXMyJGNsdXN0ZXIpCmdncGxvdChERiwgYWVzKHgsIHksIGNvbG9yID0ga21lYW5zMikpICsgCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuNSkKYGBgCgoKIyMgUGFydCAyOiBIaWVyYXJjaGljYWwgQ2x1c3RlcmluZwoKSW4gdGhpcyBleGVyY2lzZSB5b3Ugd2lsbCB5b3UgdXNlIGEgZGF0YXNldCBwdWJsaXNoZWQgaW4gYSBzdHVkeSBieQpbS2hhbiBldCBhbC4gMjAwMV0oaHR0cHM6Ly93d3cubmF0dXJlLmNvbS9hcnRpY2xlcy9ubTA2MDFfNjczKQp0byBwZXJmb3JtIGEgaGllcmFyY2hpY2FsIGNsdXN0ZXJpbmcgb2YgdGhlIHBhdGllbnRzIGluIHRoZSBzdHVkeSBiYXNlZApvbiB0aGVpciBvdmVyYWxsIGdlbmUgZXhwcmVzc2lvbiBkYXRhLgoKVGhpcyBkYXRhIHNldCBjb25zaXN0cyBvZiBleHByZXNzaW9uIGxldmVscyBmb3IgMiwzMDggZ2VuZXMuClRoZSB0cmFpbmluZyBhbmQgdGVzdCBzZXRzIGNvbnNpc3Qgb2YgNjMgYW5kIDIwIG9ic2VydmF0aW9ucyAodGlzc3VlIHNhbXBsZXMpIApyZXNwZWN0aXZlbHkuCgpIZXJlLCB3ZSB3aWxsIHVzZSB0aGUgdHJhaW4gc2V0LCBhcyB3ZSBub3cgYXJlIG9ubHkgaW50ZXJlc3RlZCBpbgpsZWFybmluZyBob3cgYGhjbHVzdCgpYCB3b3Jrcy4gRmlyc3QsIGxvYWQgdGhlIGBJU0xSYCB3aGVyZSB0aGUKZGF0YSBpcyBhdmFpbGFibGUuIFRoZSBnZW5lIGV4cHJlc3Npb24gZGF0YSBpcyBhdmFpbGFibGUgaW4gYW4gb2JqZWN0CmBLaGFuJHh0cmFpbmA7IHlvdSBjYW4gbGVhcm4gbW9yZSBhYm91dCB0aGUgZGF0YSBzZXQgYnkgdHlwaW5nIGluIGA/S2hhbmAKYWZ0ZXIgbG9hZGluZyBgSVNMUmAgcGFja2FnZS4KCmBgYHtyfQpsaWJyYXJ5KElTTFIpCmdlbmUuZXhwcmVzc2lvbiA8LSBLaGFuJHh0cmFpbgpkaW0oZ2VuZS5leHByZXNzaW9uKQpgYGAKCmEuIENvbXB1dGUgYSAoRXVjbGlkZWFuKSBkaXN0YW5jZSBtYXRyaXggYmV0d2VlbiBlYWNoIHBhaXIgb2Ygc2FtcGxlcy4KCmBgYHtyfQpEIDwtIGRpc3QoZ2VuZS5leHByZXNzaW9uKQpgYGAKCmIuIFBlcmZvcm0gaGllcmFyY2hpY2FsIGNsdXN0ZXJpbmcgdXNpbmcgYXZlcmFnZSBsaW5rYWdlLgoKYGBge3J9CmtoYW4uaGNsdXN0IDwtIGhjbHVzdChELCBtZXRob2QgPSAiYXZlcmFnZSIpCmBgYAoKYy4gUGxvdCBhIGRlbmRyb2dyYW0gYXNzb2NpYXRlZCB3aXRoIHRoZSBoaWVyYXJjaGljYWwgY2x1c3RlcmluZyB5b3UganVzdApjb21wdXRlZC4gSW4gdGhpcyBleGFtcGxlLCB5b3UgYWN0dWFsbHkgaGF2ZSB0aGUgbGFibGVzIG9mIHRoZSB0aXNzdWUgc2FtcGxlcywKaG93ZXZlciwgdGhlIGFsZ29yaXRobXMgd2FzIGJsaW5kZWQgdG8gdGhlbS4gQnkgYWRkaW5nIGxhYmVscyB0byB0aGUgZGVuZHJvZ3JhbQpjb3JyZXNwb25kaW5nIHRvIGBLaGFuJHl0cmFpbmAsIGNoZWNrIGlmIHRoZSBjbHVzdGVyaW5nIHBlcmZvcm1lZCBncm91cHMgdGhlIApvYnNlcnZhdGlvbnMgZnJvbSBzYW1lIHR1bW9yIGNsYXNzIG5lYXJieS4gCgpgYGB7cn0KcGxvdChraGFuLmhjbHVzdCwgbGFiZWxzID0gS2hhbiR5dHJhaW4pCmBgYAoKCiMjIEV4ZXJjaXNlIEV4dHJhOiAyRCB2aXN1YWxpemF0aW9uIG9mIE1OSVNUIGRhdGEKCiogRG93bmxvYWQgTU5JU1QgZGF0YSBvZiB0aGUgZGlnaXRzIGltYWdlcyBmcm9tIApbS2FnZ2xlIGNvbXBldGl0aW9uXShodHRwczovL3d3dy5rYWdnbGUuY29tL2MvZGlnaXQtcmVjb2duaXplcikuCiogVGhlIGNvZGUgaXMgYWRhcHRlZCBmcm9tIHRoZSBvbmUgZm91bmQgW2hlcmVdKGh0dHBzOi8vd3d3LmthZ2dsZS5jb20vZ29zcHVyc2dvL2RpZ2l0LXJlY29nbml6ZXIvY2x1c3RlcnMtaW4tMmQtd2l0aC10c25lLXZzLXBjYS9jb2RlKS4gCgpUaGUgZmlsZXMgYXJlIGRhdGEgb24gdGhlIDI4eDI4IHBpeGVsCmltYWdlcyBvZiBkaWdpdHMgKDAtOSkuIFRoZSBkYXRhIGlzIGNvbXBvc2VkIG9mOgoKKiBgbGFiZWxgIGNvbHVtbiBkZW5vdGluZyB0aGUgZGlnaXQgb24gdGhlIGltYWdlCiogYHBpeGVsMGAgdGhyb3VnaCBgcGl4ZWw3ODNgIGNvbnRhaW4gaW5mb3JtYXRpb24gb24gdGhlIHBpeGVsIGludGVuc2l0eQoob24gdGhlIHNjYWxlIG9mIDAtMjU1KSwgYW5kIHRvZ2V0aGVyIGZvcm0gdGhlIHZlY3Rvcml6ZWQgdmVyc2lvbiBvZiAKdGhlIDI4eDI4IHBpeGVsIGRpZ2l0IGltYWdlCgohW10oLi4vbGVjdHVyZXMvTGVjdHVyZTgtZmlndXJlLy9tbmlzdEV4YW1wbGVzLnBuZykKCkRvd25sb2FkIHRoZSBkYXRhIGZyb20gdGhlIGNvdXJzZSByZXBvc2l0b3J5OgoKYGBge3J9CiMgbG9hZCB0aGUgYWxyZWFkeSBzdWJzZXR0ZWQgTU5JU1QgZGF0YS4KbW5pc3QudXJsIDwtICJodHRwczovL2dpdGh1Yi5jb20vY21lMTk1L2NtZTE5NS5naXRodWIuaW8vcmF3L21hc3Rlci9hc3NldHMvZGF0YS9tbmlzdF9zbWFsbC5jc3YiCnRyYWluIDwtIHJlYWQuY3N2KG1uaXN0LnVybCwgcm93Lm5hbWVzID0gMSkKZGltKHRyYWluKQp0cmFpblsxOjEwLCAxOjEwXQpgYGAKCmEuIENvbXB1dGUgYW5kIHRoZSBQQ0EgZm9yIHRoZSBkYXRhLiBUaGVuLCBleHRyYWN0IHRoZSBmaXJzdCB0d28gcHJpbmNpcGFsCmNvbXBvbmVudCBzY29yZXMgZm9yIHRoZSBkYXRhLgoKYGBge3J9CiMgY29tcGFyZSB3aXRoIHBjYQpwY2EgPC0gcHJjb21wKHRyYWluWywtMV0pCmNvb3JkLnBjYSA8LSBkYXRhLmZyYW1lKHBjYSR4WywgMToyXSkKY29vcmQucGNhJGxhYmVsIDwtIGZhY3Rvcih0cmFpbiRsYWJlbCkKYGBgCgpiLiBQbG90IHRoZSAyRCBwcmluY2lwYWwgY29tcG9uZW50IHNjb3JlcyBtYXRyaXguCgpgYGB7cn0KZ2dwbG90KGNvb3JkLnBjYSwgYWVzKHg9IFBDMSwgeSA9IFBDMikpICsgZ2d0aXRsZSgiUENBIikgKwogIGdlb21fdGV4dChhZXMobGFiZWwgPSBsYWJlbCwgY29sb3IgPSBsYWJlbCksIGFscGhhID0gMC44KQpgYGAKCmMuIENvbXB1dGUgYSB0U05FIGVtYmVkZGluZy4KYGBge3J9CiMgVXNlIHRzbmUKbGlicmFyeShSdHNuZSkKc2V0LnNlZWQoMTIzKSAjIGZvciByZXByb2R1Y2liaWxpdHkKdHNuZSA8LSBSdHNuZSh0cmFpblssLTFdLCBkaW1zID0gMiwgcGVycGxleGl0eT0zMCwgCiAgICAgICAgICAgICAgdmVyYm9zZT1GQUxTRSwgbWF4X2l0ZXIgPSA1MDApCmNvb3JkLnRzbmUgPC0gZGF0YS5mcmFtZSh0c25lJFkpCmNvb3JkLnRzbmUkbGFiZWwgPC0gZmFjdG9yKHRyYWluJGxhYmVsKQpgYGAKCmQuIFZpc3VhbGl6ZSB0aGUgdFNORSAyRCBwcm9qZWN0aW9uLgoKYGBge3J9CmdncGxvdChjb29yZC50c25lLCBhZXMoeD0gWDEsIHkgPSBYMikpICsgZ2d0aXRsZSgidFNORSIpICsKICBnZW9tX3RleHQoYWVzKGxhYmVsID0gbGFiZWwsIGNvbG9yID0gbGFiZWwpLCBhbHBoYSA9IDAuOCkKYGBgCgplLiBXaGF0IGRvIHlvdSBvYnNlcnZlPyBIb3cgZG9lcyB0U05FIGNvbXBhcmUgd2l0aCBQQ0EgaW4gdGhpcyBjYXNlPwoKdFNORSBzZWVtcyB0byBiZSBtdWNoIGJldHRlciBhdCBzZXBhcmF0aW5nIGRpZ2l0cyBmcm9tIGVhY2ggb3RoZXIKCgoKYGBge3J9CnNlc3Npb25JbmZvKCkKYGBgCgoKCgoKCgoKCg==